perm filename SELIP.F4[SAB,LCS] blob sn#349454 filedate 1978-04-16 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	C       PROGRAM SELIP       
C00004 ENDMK
CāŠ—;
C       PROGRAM SELIP       
	DIMENSION IBUF(5000)
	COMMON/FAC/JFAC,KFAC
	JFAC=50
      	KFAC=50
 	CALL PLOTS(IBUF, 5000,1)
	CALL PLOT(15.,14.75,-3)
	A=6.
	B=2.8
       	DO 10 J=1,20
	CX=(RAN(K)*10.)-5.
	CY=(RAN(K)*10.)-4.
    	ANG=(RAN(K)*60.)-30
	PAUSE     
                 
1	CALL ELLIP2(A,B,CX,CY,ANG)
	CALL DPYOUT(1)
     	A=.9*A           
       	B=.9*B          
10	CONTINUE
	CALL PLOT(0.,-30.,-3)
	CALL PLOT(0.,0.,999)
 	STOP
	END 
	SUBROUTINE PLOT(X,Y,I)
	COMMON/FAC/JFAC,KFAC
	IF(I.GT.0)GO TO 1    
C	M=X
C	N=Y
	RETURN
2	CALL DPYOUT(1)
 	PAUSE
	RETURN
	
1	IF(I.EQ.999)GO TO 2
	J=(M+X)*JFAC
	K=(N+Y)*KFAC
	IF(I.EQ.2)CALL AVECT(J,K)
	IF(I.EQ.3)CALL AIVECT(J,K)
CC	NN=NN+1
CC	IF(NN.LT.20)RETURN
CC	NN=0
CC	CALL DPYOUT(1)
	END
 
	SUBROUTINE PLOTS(I,J,K)
	DIMENSION N(4000)
	CALL DPYSET(1,N,4000)
	END

	SUBROUTINE ROTATE(X,Y,N,CX,CY,ANGLE)
	DIMENSION X(1),Y(1)
	THETA=ANGLE*6.2831853/360.
	DO 1 I=1,N
	A=X(I)-CX
	B=Y(I)-CY
	X(I)=A*COS(THETA)-B*SIN(THETA) + CX
1	Y(I)=A*SIN(THETA)+B*COS(THETA) + CY
	RETURN
	END